perm filename FILLER.OLD[MSS,LCS]1 blob sn#049524 filedate 1974-01-08 generic text, type T, neo UTF8
00100		SUBROUTINE FILLER
00200		COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
00300		COMMON /RZ/RSZ,IPLT,RJB,CENTR
00400		COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
00500		DATA RC/1./
00600		PX=2
00610		IF(MFILL(1).GT.60)PX=3
00700		CNZ=RSZ
00800		DNZ=1.0
00900		IF(IPLT.GE.0)GO TO 101
01000		IF(IXRX.EQ.1)DNZ=1.1
01100		PX=1
01200		CNZ=1.7*CNZ
01400	C  DNZ IS TO FATTEN IT ON THE XGP
01450	101	FNZ=CNZ*DNZ
01500		RBZ=RJB*CNZ*DNZ
01600	C  1.7 IS FOR THIS TEST PROG. ONLY
01700		NX=2
01800	C  NX IS POINTER IN X ARRAY
01950		ID=MFILL(NX)
02000	100	RM=-1000
02100		I=NX+1
02200	103	CALL UNPACK(I,IA,IB,MFILL)
02210		IF(IA.NE.MFILL(I+1)/10000)GO TO 102
02220		I=I+1
02230		GO TO 103
02300	102	G=IA+RJB
02400		H=IB+CENTR
02500		IF(IPLT)GO TO 200
02600		CALL LINES(G,H,3)
02700		GO TO 300
03500	200	IF(IXRX.EQ.0)GO TO 90
03600		M=ROFF(-H*CNZ)
03700		N=ROFF(G*FNZ+XGP)
03800		GO TO 80
03900	90	M=ROFF(G*CNZ)
04000		N=(H*CNZ)
04100	80	CALL PLOT(M,N,3)
04200	C  X POINTER
04300	300	NN=ID-1
04400	C  LAST OF ARRAY-1
04500		P=IA*FNZ
04600		CALL UNPACK(I+1,IG,H,MFILL)
04700		RB=IG*FNZ+PX
04710	CC	RB=IG*FNZ+PX-1
04800		J=1
04900	1	JJ=1
05010		IF(RM.GT.RB)GO TO 13
05100		IF(J)GO TO 2
05200	3	CALL NNN(NN,1,0)
05300	C  FINDS BOTTOM POINTER
05400		GO TO 16	
05500	2	CALL NNN(I,0,1)
05600	C  FINDS TOP POINTER(I)
05700	16	CALL UNPACK(N,JA,JB,MFILL)
05800		CALL UNPACK(N+1,JG,JH,MFILL)
05900		CALL UNPACK(NQ,IQ,H,MFILL)
06000		RZ=RZ*FNZ
06010		IF(P.GT.RZ)P=RZ
06100		Q=IQ*FNZ
06200		C=(IC+CENTR)*CNZ
06300	10	DIS=JA-JG
06400		IF(DIS.NE.0)GO TO 6
06500	C  FOR STRAIIGHT UP-DOWN LINES
06550		IF(NN-1.EQ.I)GO TO 13
06600		P=P-PX
06700		GO TO 50
06800	6	H=(JB-JH)/(DIS*DNZ)
06807	C  MOVES ONLY LEFT TO RIGHT
06810	11	HH=(P-Q)*H+C
06820	1111	PP=P+RBZ
06900		IH=ROFF(HH)
07000		IP=ROFF(PP)
07005	C  RN IS FOR ROUND-OFF ERRORS
07010		IF(IP.EQ.MP.AND.IH.EQ.MH)GO TO 180
07020		MP=IP
07030		MH=IH
07040	C  OMITS REPEATED POINTS
07100		IF(IPLT)GO TO 17
07200		CALL AVECT(IP,IH)
07300		GO TO 180
07400	17	IF(IXRX.EQ.0)GO TO 19
07500		K=IP
07600		IP=-IH
07700		IH=K+XGP
07800	19	CALL PLOT(IP,IH,2)
08100	180	JJ=JJ-1
08200		IF(JJ)GO TO 12
08250		RM=P
08300		P=P+PX
08510		IF(P.LT.RZ)GO TO 11
08600	5	CALL DPYOUT(1)
08700	50	IF(J)GO TO 4
08800		NN=NN-1
08850		IF(I.GT.NN)GO TO 13
08900		GO TO 3
09000	4	I=I+1
09050		IF(I.GT.NN)GO TO 13
09100		CALL UNPACK(I+1,IA,IB,MFILL)
09200		RB=IA*FNZ+PX
09210	CC	RB=IA*FNZ+PX-1
09300		GO TO 2
09400	12	J=-J
09500		GO TO 1
09600	13	NX=ID+1
09705		IF(ID.EQ.MFILL(1))GO TO 130
09710		ID=MFILL(NX)
09800		GO TO 100
09900	130	CALL DPYOUT(1)
09910		MP=1000
09920		MH=1000
10000		RETURN
10100	14	FORMAT(2I4)
10200		END
10300		SUBROUTINE NNN(J,L,K)
10400		COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
10500		COMMON /RZ/RSZ,IPLT,RJB,CENTR
10600		COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
10700		CALL UNPACK(J+K,IZ,IC,MFILL)
10800		CALL UNPACK(J+L,N,IC,MFILL)
11000		N=J
11100	C  C IS THE CONSTANT
11300		NQ=N+L
11320		RZ=IZ
11400		RETURN
11500		END
11600	
11700		FUNCTION ROFF(R)
11800		S=.5
11900		IF(R)S=-S
12000		ROFF=R+S
12100		RETURN
12200		END